\ Web Browser Example
\ Tom Dixon
\ 10/6/2008

\ This shows how to embed an entire web browser into a child window.

include FCOMbase.bld
include ACTIVEX
also FCOM

\ Load MSHTML TypeLibrary
1 1 typelib {EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}

IWebBrowser2 comiface browser

: html-close ( -- ) 
   browser COM IWebBrowser2 Quit drop 
   browser freeref ;

: html-URL! ( str len -- ) \ browse to a URL
   >unicode drop 0 0 0 0 browser Navigate drop ;
   
: html-URL@ ( -- str len ) \ get the current URL
   pad browser GetLocationURL drop 
   pad @ zunicount u16>ascii
   pad @ bstrfree ;

: html-offline? ( -- flag ) \ returns true if unconnected to internet 
   pad browser GetOffline drop pad @ ;

: html-busy? ( -- flag ) \ returns true if browser is busy
   pad browser GetBusy drop pad @ ;

\ Navigation Commands

: html-goHome ( -- ) browser GoHome drop ;
: html-goForward ( -- ) browser GoForward drop ;
: html-goBack ( -- ) browser GoBack drop ;
: html-Refresh ( -- ) browser Refresh drop ;
: html-stop ( -- ) browser COM IWebBrowser2 Stop drop ;



\ =====================================================
\ Define a Window resource Template for the Main Window
\ =====================================================

NULL value hChild
NULL value hWindow

NextID: IDW_MAINWINDOW

IDW_MAINWINDOW WINDOW 0, 0, 800, 600
BEGIN
   Caption         "Browser Window"
   Style           WS_POPUP | WS_BORDER | WS_SYSMENU |
                   WS_CAPTION | WS_THICKFRAME | WS_MINIMIZEBOX |
                   WS_MAXIMIZEBOX | WS_CLIPSIBLINGS | WS_VISIBLE
   ClassStyle      CS_HREDRAW | CS_VREDRAW
   Icon            IDI_APPLICATION
   Cursor          IDC_ARROW
   Brush           WHITE_BRUSH
   Menu            NULL
   WndProc         TestWindowProc
END

: Resize-Child ( lparam -- )
  hChild 0 rot 0 swap
  dup $FFFF and swap 16 rshift $FFFF and
  1 MoveWindow drop ;


\ =====================================================
\ Child window that will host the ActiveX control
\ =====================================================

NextID: IDW_Child

IDW_Child WINDOW    0, 0, 800, 570
BEGIN
        Caption     "child window"
        Style       WS_VISIBLE | WS_THICKFRAME | CCS_NORESIZE
        ClassStyle  CS_HREDRAW | CS_VREDRAW
        Icon        IDI_APPLICATION
        Cursor      IDC_ARROW
        Brush       WHITE_BRUSH
        Menu        NULL
        WndProc     ChildWindowProc
END

: ChildWindowProc       { hwnd mesg wparam lparam -- ior }
  case mesg
    WM_CREATE of  hwnd -> hChild  1  endof      \ 1 so that default is performed
    WM_DESTROY of  0 -> hChild  1  endof        \ 1 so that default is performed
      drop  hwnd mesg wparam lparam DefWindowProc
  end-case
;

: RunChild      \ --
  hChild 0= if
    IDW_Child hWindow RESOURCE::CreateChildWindow -> hChild
    WebBrowser CLSID>Str >ascii hChild AXCreate
    browser freeref
    browser IWebBrowser2 hChild AXQuery
  endif
;

: CloseChild    \ --
  hChild if
    html-close  hChild SendClose
  endif
;

: TestWindowProc        \ hWnd uMessage wParam lParam -- res
  { hWnd uMessage wParam lParam -- res }
  uMessage case
    WM_SIZE of  lParam Resize-Child  0  endof
    WM_CREATE of  hWnd -> hWindow  1  endof
    WM_DESTROY of  0 -> hWindow  1  endof
      drop  hWnd uMessage wParam lParam DefWindowProc
  end-case
;

: Run ( -- )
  hWindow 0= if
    IDW_MAINWINDOW Resource::CreateParentWindow -> hWindow
    RunChild
  endif
;

: Close ( -- )
  hWindow if
    CloseChild  hWindow SendClose
  endif ;

free-lasttypelib
previous


